home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d10
/
ps1410.arc
/
CAL2.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-10-31
|
71KB
|
1,945 lines
'=========================================================================
' Personal Calendar (PC) Program
' Copyright (c) 1985-1990, Paul Munoz-Colman. All Rights Reserved.
' Version 14.10
' 31 Oct 1990
' Shareware $25
'=========================================================================
' DOS File CAL2.BAS
' Independently Compiled Subprogram Which Is Linked With CAL1.BAS
'=========================================================================
' Written For IBM PCs & Compatibles Under MS DOS 3.30 on a Northgate 486
' Compiled By Microsoft Professional BASIC 7.10, Linker Version 5.10
'=========================================================================
' Note -- Tabs in the source file are in positions 6,11,16,21,26,...
'=========================================================================
' $INCLUDE: 'cal1.bi'
'=========================================================================
' Only Subprogram in this File
' (compiled WITHOUT error handling--no /E or /X)
'-------------------------------------------------------------------------
' Name Purpose
' --------------------------- ---------------------------------------
' MainSub Main Procedure
'=========================================================================
SUB MainSub (MainEntryPoint) STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 1
'=========================================================================
' This Procedure Exits ONLY Through a Trapped Error and Always Returns
' (except in primitive mode, which ends in the main program)
'=========================================================================
IF MainEntryPoint = 2 THEN GOTO StartupScreenExit
'=========================================================================
IF MainEntryPoint = 3 THEN GOTO MainMenuEntry
'=========================================================================
' MainEntryPoint = 1 is the Startup Entry -- below
'=========================================================================
' Initialize required variables for primitive state
'-----------------------------------------------------------
N0 = 0 ' Variables instead of constants
N1 = 1 ' save program size and stack space
N2 = 2 ' big time !!
N3 = 3 ' These are the most frequently used.
N4 = 4
N5 = 5
N6 = 6
N7 = 7
N8 = 8
N9 = 9
N10 = 10
N11 = 11
N12 = 12
N13 = 13
N14 = 14
N15 = 15
N16 = 16
N17 = 17
N18 = 18
N19 = 19
N20 = 20
N21 = 21
N22 = 22
N23 = 23
N24 = 24
N25 = 25
N26 = 26
N27 = 27
N28 = 28
N29 = 29
N30 = 30
N32 = 32
N34 = 34
N38 = 38
N39 = 39
N40 = 40
N42 = 42
N43 = 43
N45 = 45
N48 = 48
N49 = 49
N50 = 50
N52 = 52
N53 = 53
N54 = 54
N58 = 58
N60 = 60
N62 = 62
N63 = 63
N64 = 64
N68 = 68
N70 = 70
N71 = 71
N72 = 72
N74 = 74
N75 = 75
N80 = 80
N99 = 99
Nm1 = -1
Nm2 = -2
Nm3 = -3
Blank0$ = "" ' Null String
Blank1$ = " " ' 1 Blank Space
Blank2$ = SPACE$(2) ' 2 Blank Spaces
Blank3$ = SPACE$(3) ' 3 Blank Spaces
Blank4$ = SPACE$(4) ' 4 Blank Spaces
Blank8$ = SPACE$(8) ' 8 Blank Spaces
Blank12$ = SPACE$(12) ' 12 Blank Spaces
Blank80$ = SPACE$(80) ' 80 Blank Spaces
Hyphen$ = "-"
False$ = "n" ' Logical No
Zeroo$ = "0"
No = N0 ' Numeric No
Noo$ = "No"
True$ = "y" ' Logical Yes
Yess$ = "Yes"
Yes = Nm1 ' Numeric Yes
WindowInitted = No ' Window Manager Initialization
ErrMsgPlacement = 5
PrimitiveState = Yes
'=========================================================================
' Assign File Numbers for I/O
FilenumAppt = N1 ' File number of Appointment File
FilenumApptSort = N2 ' File number of Appointment Sort File
FilenumAuto = N3 ' File number of Automatic Start File
FilenumCopy = N4 ' File number of ASCII Copy File
FilenumDOS = N5 ' File number of DOS Command File
FilenumError = N6 ' File number of Error Message File
FilenumExcl = N7 ' File number of History Exclude File
FilenumFig = N8 ' File number of Color Choice File
FilenumHelp = N9 ' File number of Help Text File
FilenumInit = N10 ' File number of Program Init File
FilenumMusic = N11 ' File number of Music Choice File
FilenumNewAppt = N12 ' File number of New Appt File
FilenumOverdue = N13 ' File number of Overdue Events (.clv)
FilenumRes = N14 ' File number of Stay-Res Option File
FilenumSer = N15 ' File number of Registration Data
'-------------------------------------------------------------------------
CALL MhDver(DOSMajorVersion%, DOSMinorVersion%) ' Get DOS Version
IF DOSMajorVersion < N3 THEN 'Get DOS Version
DOS2x = Yes 'TSR features disabled if not
ELSE ' 3.0 or later
DOS2x = No
END IF
'=========================================================================
' Stay-Res Initialization -- Part 1 of 2
'=========================================================================
IF NOT DOS2x THEN 'See if program already in
CALL StayResInitialization(N0) ' memory, if so pop up, if not,
END IF ' terminate this copy
'=========================================================================
Insrt% = -2
PriorInsert = -2
ScreenPage = N0 ' Set calendar screen page
HardSnooze = Yes ' Don't allow Snooze interruption
CALL VideoMonitorType ' Determine Color or Monochrome
IF ColorCRT THEN ' Set Color Defaults
Cl1f = N1 ' Blue on Whi Events (1) and (8)
Cl1b = N7
Cl2f = N4 ' Red on Whi Notes (2) and (9)
Cl2b = N7
Cl3f = N9 ' BrBlu on blk Clocks (3) and (10)
Cl4f = N3 ' Cyan on blk Calendars (4) and (11)
Cl5f = N15 ' BrWhi on blu Menus (5) and (12)
Cl5b = N1
Cl6f = N2 ' Grn on blk Instructions (6) and (13)
Chf = N15 ' BrWhi on blk Emphasis (7) and (14)
ELSE
Cl1f = N7 ' Monochrome Settings
Cl2f = N7
Cl3f = N7
Cl4f = N7
Cl5f = N7
Cl6f = N7
Chf = 14
Cif = N7
Cib = 8
END IF
'-------------------------------------------------------------------------
' Change the Cursor Shape Depending Upon Insert Mode
' Insert On is normal DOS Cursor; Overstrike is Full Solid Cursor
' The mono display adapter has lines 0 to 13, the color has 0 to 7
' in the LOCATE statement for the cursor size
OverstrikeCursorStart = N0
IF MonoCRT THEN
InsertCursorStart = 12 ' Mono Cursor Defaults
CursorStop = 13
ELSE
InsertCursorStart = N6 ' Color Cursor Defaults
CursorStop = N7
END IF
CursorStart = InsertCursorStart
CursorState = N0
'-------------------------------------------------------------------------
CALL SaveDOSKeyState ' Save DOS keys and page
UserSaved = No ' Reset user screen saved flag
CALL SetVideoMode(N0) ' Change to Text Mode if not there
CALL SetVideoPage(N0) ' Change to Page Zero if not there
'=========================================================================
CALL Kolors(N6)
CLS
CALL BoxDraw(N2, N11, N15, N15, N64)
Tag$ = " Please Wait--Personal Calendar is Initializing "
CALL ShowIt(N17, N13, Nm2, Tag$)
'-------------------------------------------------------------------------
NewGuy = Yes
IF ColorCRT THEN
CALL ReadCalfig ' Read (or write) Color Choices
END IF
'=========================================================================
MemoryResident = No ' Set non-zero once resident first time
NumberofHotFKeys = 10
NumberofHotCKeys = 16
CALL ReadCalinit(N1) ' Fixed Array Initialization
CALL SaveCurrentDirectory(N1) ' Get Calendar Directory
'=========================================================================
' Stay Res Initialization -- Part 2 of 2
'=========================================================================
' This reads the CALRES.DAT file and sets all early options
IF NOT DOS2x THEN
CALL StayResInitialization(N1)
END IF
'=========================================================================
' Initialize Remaining Variables
'=========================================================================
' Debugging Mode If Desired
IF InString(COMMAND$, "DEBUG") THEN
DebugRequested = Yes
ELSE
DebugRequested = No
END IF
AllowInsertMode = No
DateFromDOS$ = DATE$
TodaysDate$ = MID$(DateFromDOS$, N7, 4) + MID$(DateFromDOS$, N1, N2) + _
MID$(DateFromDOS$, 4, N2)
'=========================================================================
AlarmMusicPlayed = Yes
AlarmSet = No
ApptFile = No
ApptFilename$ = Blank8$
AutoMode$ = False$
Bsp = 8
CalendarColumns(N1) = N1
CalendarColumns(N2) = 25
CalendarColumns(N3) = 49
CalendarDate$ = TodaysDate$
CalendarStartRow = 8
CapsHold = N0
ClockPositionGraphic$ = CHR$(176) ' Dark-Screened Whole Character (░)
ClockScreen = No
ClockScreenPrint = No
ClockSeparatorGraphic$ = CHR$(178) ' Light-Screened Whole Character (▓)
Column1 = N1 ' Columns for Clock Screen
Column2 = 26 ' Instructions
Column3 = 46
Column4 = 67
CopyFilename$ = Blank12$
CurrentEvent = N1
CurrentEventLine$ = Blank80$
CurrentNote = N1
CurrentNoteHist = N1
CursorColumn = N1
CursorRow = N1
Del = 83
DesiredCalendars$ = TodaysDate$
DirectReturn = No
DownArrow$ = CHR$(25) ' Down-Arrow Character
EarlyPopDownFailed = No
East = 77
EchoSuppression = No
EditPagesize = 20
EndKey = 79
Enter = 13
ErrorMessageToWrite = No
Esc = 27
EventDate$ = SPACE$(8)
EventTime$ = SPACE$(4)
EventDateTime$ = SPACE$(12)
EventPageCounter = N0
EventSizeCode$ = "e" ' Default 60 Events
EventTableSize = 60 ' Default Number of Events
EventTableStable = No
EventYear$ = SPACE$(N2) ' Fix sizes of these variables
EventMonth$ = EventYear$ ' so MhMidString can be used without
EventDay$ = EventYear$ ' reassigning them later
EventHour$ = EventYear$
EventMinute$ = EventYear$
EventLimRepeat$ = EventYear$
EventRepeat$ = SPACE$(N3)
EventYear1st2$ = EventYear$
EventText$ = SPACE$(53)
EventtoHistory = Yes
F1 = 59
F2 = 60
F3 = 61
F4 = 62
F5 = 63
F6 = 64
F7 = 65
FirstTimeClock = Yes
FirstTimeExecuted = Yes
FooterAction$ = Blank1$
FooterRecall = No
FooterSize = 5
ForceDate = No
HighestValue# = 999999999999# ' High Long Value
HomeKey = 71
InclHistory = No
InclNotes = Yes
InHelp = No
InMenu = No
Ins = 82
InterruptedLoop = No
KeyCursor = 4 ' KeyStuff Functions
KeyCursorOff = -4
KeyDelayedExit = No
KeyNumOn = 5
KeyNumOff = N6
KeyShiftTrap = N0
KeyStatus = N1
KeyStatusAbs = 8
KeySingle = N2
KeyTimerInit = N7
KeyTrapEnabled = No
KeyWait = N3
LeftArrow$ = CHR$(27) ' West-Arrow Character
LimSep$ = Blank1$
LoopCounterShow = Yes
MainMenuAuto = 10
MainMenuClock = N2
MainMenuColor = 13
MainMenuCopy = N7
MainMenuCreate = 4
MainMenuDate = 11
MainMenuDelete = 5
MainMenuDOS = 12
MainMenuHelp = 9
MainMenuList = N3
MainMenuOptions = 8
MainMenuPrint = N6
MainMenuRow = N7
MainMenuUse = N1 ' Main Menu Values
MenuCancelled = N1 ' Menu Exit from ESC Key
MenuEntryChosen = N0 ' Menu Exit from Enter Key
MenuNormalExit = N0 ' Menu Exit from Enter Key
MenuRecursiveReturn = No
MenuRow = N7
MenuSize = N0
MenuSpecialExit = N0 ' Menu Exit other than Escape
MovingClockTick$ = CHR$(4) ' Diamond ()
NoHistEndDefault = No
NormalCalendars = Yes
North = 72
NoteSize = N2
NoteSizeCode$ = "e" ' Default 60 Notes
NullEvent$ = " - - :" + SPACE$(57)
'Null Event
NullEventOld$ = " - - :" + SPACE$(58)
NumberofEvents = EventTableSize
NumberofNotes = 60
NumHold = N0
OldNumberEvents = NumberofEvents
OldNumberNotes = NumberofNotes
OnEditPage = No
OnScreen = No
OtherCalendars = No
OverdueCount = N0
OverduePosition = N1
PathLegalChars$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890(){}@#$%^&!-_'~.\"
PathLegalLength = LEN(PathLegalChars$)
Pending = 5
PgDn = 81
PgUp = 73
PopWait = No
PopWaitHold = No
PrecursorChime$ = "mb o3 mn t55 l6"
PrintedEventsScheduled = Nm1
PrinterLineCount = 1
PrinterLineLimit = 0
PrinterPause$ = False$
PrintingReport = No
PrintorCopy$ = "p"
Prnt = 42
RedisplayNotesEvents = Yes
Rescheduling = No
ReturnMessage$ = Blank0$
RightArrow$ = CHR$(26) ' East-Arrow Character
ScreenSize = 20
ScrollingCalendars = No
SoundLevel = 4
South = N80
SpecialExitAllowed = N1 ' Menu Special Exits Allowed
SpecialExitDelete = N2 ' Menu Delete Key For Item Delete
SpecialExitDisallowed = N0 ' Menu Special Exits Not Allowed
SpecialExitEndKey = N7 ' Menu End Key For Last Page
SpecialExitF2 = 5 ' Menu F2 For Event Resequencing
SpecialExitHomeKey = N6 ' Menu Home Key For 1st Page
SpecialExitInsert = N1 ' Menu Insert Key For Item Insertion
SpecialExitPgDn = 4 ' Menu Page Up For Previous Page
SpecialExitPgUp = N3 ' Menu Page Down For Next Page
StartingHistory = N2 + NumberofEvents + NumberofNotes 'Default 12
StartingNote = N2 + NumberofEvents 'Default 62
StartupScreen = Yes
StartupScreenHold = StartupScreen
Tabb = 9
TextSize = LEN(EventText$)
UpArrow$ = CHR$(24) ' Up-Arrow Character
ValidSizes$ = "cdefghijklmnopq" ' 20 to 300 size codes
WarningSet = No
WeekBreak$ = True$
WeekendScheduling$ = False$
West = 75
WhichColor = N0
WhichEvent = N1
ZeroLine = Strng$(N80, N0)
'=========================================================================
CALL ReadCalinit(N2) ' Fixed Array Initialization
'-------------------------------------------------------------------------
' Set Printer Array to None Selected
PrinterCodes(1) = -99
'=========================================================================
' Set Printer Default
'=========================================================================
AvailablePrinters$ = "EIP4-" ' Epson, IBM, HPIIP/III, IBM4019, None
SelectedPrinter$ = "-" ' Default to no initialization
'=========================================================================
FatalError = Yes
PrimitiveState = No
'=========================================================================
' Greeting Screens
'=========================================================================
CALL ClearScreenNormal(N0)
'=========================================================================
' Enable Exiting Keys (Ctrl-Break and Ctrl-Esc)
'=========================================================================
ExitKeys = Yes
'=========================================================================
' Greeting Screen 1
'=========================================================================
CALL ReadCalser ' Get User Validation
CALL GenGreetingScreen1 ' Display Startup Screen
CALL KeyStuff(KeyStatusAbs) ' Display CAPS/NUML State First Time
HardSnooze = No ' Allow keystroke-interrupted
CALL Snooze(5!) ' Sleep for 5 seconds
StartupScreenExit:
StartupScreen = No
StartupScreenHold = StartupScreen ' In case 1st popped down right away
'=========================================================================
CALL ReadCalauto ' Read (or write) Auto Startup File
'-------------------------------------------------------------------------
' If User wants to be forced to set date & time
IF ForceDate THEN
CALL SetDateTime
END IF
'=========================================================================
' Greeting Screen 2
'=========================================================================
CALL ClearScreenNormal(N1)
CALL GenerateGreeting(N2)
CALL DisplayApptFilename ' And Show Filename If It Exists
'-------------------------------------------------------------------------
' Done Here So Greeting Is First
IF (NewGuy = Yes OR UpdatingCalfig = Yes) AND ColorCRT THEN
UpdatingCalfig = No
CALL Snooze(0.7!)
CALL PrepareforMessage
CALL ShowIt(N0, N0, N0, _
" Created/Updated Color Choice File CALFIG.DAT")
END IF
'-------------------------------------------------------------------------
IF NewGuy OR UpdatingCalres THEN
CALL Snooze(0.7!)
CALL PrepareforMessage
CALL ShowIt(N0, N0, N0, _
" Created Memory-Resident Choice File CALRES.DAT")
END IF
'-------------------------------------------------------------------------
IF UpdatingCalauto THEN
CALL Snooze(0.7!)
CALL PrepareforMessage
CALL ShowIt(N0, N0, N0,_
" Created/Updated Automatic Startup File CALAUTO.DAT")
UpdatingCalauto = No
END IF
'=========================================================================
CALL ReadCalmusic ' Get Music Choices or Set Them
'=========================================================================
CALL ReadCalexcl ' Get History Exclusions or Set Them
'=========================================================================
CALL ReadCalDOS ' Get Prestored DOS Command or Set It
'=========================================================================
' Test For Automatic Startup
' (Automatic Startup is Cancelled By an Early TSR Error)
AutoStarted = No
IF AutostartMode THEN
AutoStarted = Yes
Tag$ = " Please Wait -- "
CALL ShowIt(N13, N11, Nm2, Tag$)
Tag$ = " Automatic Startup Is In Progress "
CALL ShowIt(N0, Nm2, Nm2, Tag$)
IF SrAutoPopDown AND NOT SrAutoPopDownHappened THEN
Tag$ = " ... and Automatic Pop Down Has Been Requested "
CALL ShowIt(N0, - N3, Nm2, Tag$)
END IF
END IF
IF MonoCRT THEN
MainMenuLastEntry = 13
ELSE
MainMenuLastEntry = 14
END IF
'=========================================================================
' Get Rid of CALTODAY.DAT File If There (Not Used Any More)
Tag$ = "caltoday.dat"
CALL KillAFile(Tag$)
'-------------------------------------------------------------------------
GOSUB TodaysDateSet
GOTO MainMenuEntry
'-------------------------------------------------------------------------
' Today's Day Of Week, Date, and Time (Referenced After SetDateTime)
TodaysDateSet:
TodaysDate$ = MID$(DATE$, N7, 4) + MID$(DATE$, N1, N2) + _
MID$(DATE$, 4, N2)
CALL DayDate(TodaysDate$)
TodaysDay = IndexedDay
CurrentTime$ = MID$(TIME$, N1, N2) + MID$(TIME$, 4, N2) + _
MID$(TIME$, N7, N2)
CurrentDateTime$ = TodaysDate$ + MID$(CurrentTime$, N1, 4)
CurrentDateTime# = VAL(CurrentDateTime$)
RETURN
'=========================================================================
' Main Menu Entry
'=========================================================================
MainMenuEntry:
PrintingReport = No
OnEditPage = No
'-------------------------------------------------------------------------
' This Clears the Screen
IF ErrorMessageToWrite THEN ' All Error Messages Are
' Shown Here Just Before
CALL PrepareforFatal ' Return to Main Menu
CALL ShowIt(N0, ErrMsgPlacement, N0, ErrorLine1$)
CALL ShowIt(N0, Nm1, N0, ErrorLine2$)
END IF
'-------------------------------------------------------------------------
IF NOT FirstTimeExecuted OR ErrorMessageToWrite THEN
ErrorMessageToWrite = No
ELSE
FirstTimeExecuted = No
END IF
'-------------------------------------------------------------------------
IF NewGuy THEN 'New User -- Wait 5-6 seconds, then go to help
Tag$ = " Hello, new user. Help is on the way! -- "
CALL ShowIt(N15, N15, Nm2, Tag$)
CALL PlayStuff(Alarm$)
ErrorSwitch = No
CALL KeyStuff(KeyStatus)
CALL Snooze(2.5!)
CALL BlankFatal ' Kill Message after 2.5 seconds
CALL Snooze(3!)
GOTO HelpEntry ' Go to Help after 5.5 seconds
END IF
CreatingFile = No
'-------------------------------------------------------------------------
' ApptFile Says Whether An Appointment File Is Open
IF NOT EventTableStable THEN
CALL CloseFiles
END IF
IF NOT AutoStarted THEN
'--------------------------------------------------------------------
' Menu Handler Uses MenuLines$ Array For Choice Lines, Maximum 20
'--------------------------------------------------------------------
MenuLines(N1) = "Use or Change an Existing Appointment File"
MenuLines(N2) = "Clock and Calendar Alone"
MenuLines(N3) = "Display a List of Saved Appointment Files"
MenuLines(4) = "Create a New Appointment File"
MenuLines(5) = "Delete Appointment File"
MenuLines(N6) = "Print Appointment File"
MenuLines(N7) = "Copy Appointments to an ASCII DOS File"
MenuLines(8) = "Options for Appointment File"
MenuLines(9) = "Help"
IF NOT DOS2x THEN
MenuLines(10) = _
"Memory-Resident (TSR Mode) Options and Automatic Startup"
ELSE
MenuLines(10) = "Automatic Startup"
END IF
MenuLines(11) = "Change DOS Date and Time"
MenuLines(12) = "DOS Session or Command"
MenuLines(13) = "Color Choices" ' Not On Monochrome Menu
' Because On Monochrome, This Entry Overlays the Color Choice Entry
MenuLines(MainMenuLastEntry) = "Direct to the Clock Screen"
END IF
'-------------------------------------------------------------------------
' If Monochrome, No Color Change Choice
' If Not Returning To Menu From Other Screens, Last Choice Suppressed
IF DirectReturn AND ApptFilename$ = Blank8$ THEN
DirectReturn = No
Menu1 = MainMenuUse
END IF
IF DirectReturn THEN
MenuSize = MainMenuLastEntry
ELSE
MenuSize = MainMenuLastEntry - N1
END IF
RedisplayCalendars = Yes
IF AutoStarted THEN
'--------------------------------------------------------------------
IF ApptFilename$ <> Blank8$ THEN
MenuChoice = MainMenuLastEntry ' Auto Start With File
Menu1 = MainMenuLastEntry
GOTO AppointmentExistCheck
ELSE
MenuChoice = N2 ' Auto Start Without File
Menu1 = MainMenuClock
AutoStarted = No
GOTO ProcessMenuChoice
END IF
END IF
MainMenuRow = N7
GOSUB ClearFilenamePass
GOTO GreetingShow
'-------------------------------------------------------------------------
' Clear File Name and Password off Screen Before Menu is Generated
ClearFilenamePass:
CALL ShowMult(N6, N23, N1, N39, N2)
RETURN
'-------------------------------------------------------------------------
GreetingShow:
CALL GenerateGreeting(N3) ' Top of Main Menu Screen (3 line version)
CALL ReturnLine
CALL QuitLine
IF NOT DOS2x THEN CALL PopLine
CALL MenuDriver(MenuSize, Menu1, MainMenuRow, Nm1, No, N0, N0, N1)
CALL ReturnLineDelete
CALL QuitLineDelete
IF NOT DOS2x THEN CALL PopLineDelete
IF MenuExit = MenuCancelled THEN CALL EndItAll
CALL BlankFatal
'-------------------------------------------------------------------------
' Process Menu Choice
'-------------------------------------------------------------------------
ProcessMenuChoice:
SELECT CASE Menu1
CASE MainMenuUse, MainMenuCreate TO MainMenuOptions ' Opens File
GOTO StartAppointment
CASE MainMenuClock
GOTO ClockInitialize ' 2 = Clock/Calendar Only
CASE MainMenuList
CALL FileList ' 3 = Display Appointment Files
CASE MainMenuHelp
HelpEntry:
CALL Help ' 9 = Help
IF NewGuy THEN
Menu1 = MainMenuCreate ' Set New Ones To Create
NewGuy = No
END IF
CASE MainMenuAuto
CALL AutoStart '10 = Automatic Startup
CASE MainMenuDate
CALL SetDateTime '11 = Change DOS Date/Time
GOSUB TodaysDateSet ' and Associated Parameters
CASE MainMenuDOS '12 = DOS Session
CALL DOSShell(N0) ' and Return
CASE 13, 14 '13/14 = Color Choices / Return
' Set Colors
IF ColorCRT THEN
IF Menu1 = MainMenuLastEntry - N1 THEN
CALL SetColors
GOTO MainMenuEntry
END IF
END IF
' Direct Return
IF Menu1 = MainMenuLastEntry AND EventTableStable THEN
GOTO EventEditStart
END IF
IF Menu1 = MainMenuLastEntry THEN
GOTO AppointmentExistCheck
ELSE
GOTO StartAppointment
END IF
END SELECT
GOTO MainMenuEntry
'-------------------------------------------------------------------------
' All Functions That Request Access To Appointment File Start Here
' (Functions 1, 4, 5, 6, 7, 8
' Use, Create, Delete, Print, Copy, Options)
'-------------------------------------------------------------------------
' Skip File Name/Password Stuff If Already In Use
' 6 (Print), 7 (Copy), 8 (Options)
StartAppointment:
IF (Menu1 <= MainMenuDelete OR Menu1 >= MainMenuHelp) OR _
NOT DirectReturn THEN
TimerSave! = TIMER
InputResponse$ = ApptFilename$
Tag$ = "Appointment File Name"
CALL ControlledInput(N23, N28, N23, N5, N8, Tag$, _
InputResponse$, N0, N1, N1, N1)
IF Keystroke$ = CHR$(Esc) THEN
CALL ClearScreenNormal(N1)
AutoStarted = No
GOTO MainMenuEntry
END IF
IF ApptFilename$ <> InputResponse$ THEN
EventTableStable = No
CALL CloseFiles
END IF
ApptFilename$ = InputResponse$
IF ApptFilename$ = Blank8$ THEN
CALL FileList
AutoStarted = No
GOTO MainMenuEntry
END IF
END IF
'=========================================================================
' Open Appointment File, New Or Otherwise
AppointmentExistCheck:
IF EventTableStable AND Menu1 <> MainMenuCreate THEN GOTO OptionsProcessing
'-------------------------------------------------------------------------
' See if it is there
ApptExists = FileExist(ApptFilename$ + ".cld")
'=========================================================================
' If Existing On Create, A Mistake
' If Not Exists On Use, A Mistake
IF Menu1 <> MainMenuCreate AND ApptExists THEN
' Open as Random and Proceed
CALL OpenAppts ' Exists On Non-Create, Okay
EventTableStable = No
ApptFileStatus$ = "o"
GOTO OptionsProcessing
END IF
'-------------------------------------------------------------------------
IF Menu1 = MainMenuCreate AND NOT ApptExists THEN
GOTO ReplaceFile ' Absent On Create, Okay
END IF
'=========================================================================
' Menu for Exists On Create or Non Exists On Use
DirectReturn = No
EventTableStable = No
OnEditPage = No
CALL MajorBeeper
CALL ClearScreenNormal(N1)
IF Menu1 <> MainMenuCreate THEN
ScreenTitles$(N1) = "Non-Existent Appointment File"
ELSE
ScreenTitles$(N1) = "Appointment File Already Exists"
END IF
CALL Titles(N1)
MenuLines(N1) = "Enter The File Name Again"
MenuLines(N2) = "Display A List Of Saved Appointment Files"
IF Menu1 <> MainMenuCreate THEN
MenuLines(N3) = "Create A New Appointment File"
ELSE
MenuLines(N3) = _
"Wipe Out Existing Appointment File And Create New One"
END IF
IF Menu1 = MainMenuDelete THEN MenuSize = N2 ELSE MenuSize = N3
CALL MenuDriver(MenuSize, Menu2, MainMenuRow, Nm1, No, N0, N1, N1)
CreatingFile = No
CALL BlankFatal
IF MenuExit = MenuCancelled THEN
CALL ClearScreenNormal(N1)
AutoStarted = No
GOTO MainMenuEntry
END IF
SELECT CASE Menu2
CASE 1 ' Enter Name Again
GOTO StartAppointment
CASE 2
CALL FileList ' List of Existing Files
GOTO MainMenuEntry
CASE 3
ReplaceFile:
IF Menu1 = MainMenuCreate THEN
CLOSE
Tag$ = ApptFilename$ + ".cld"
CALL KillAFile(Tag$)
END IF
CALL OpenAppts ' Create A New Appointment File
CreatingFile = Yes ' or Wiping Out Old And Creating New
ApptFileStatus$ = False$
DirectReturn = Yes
GOTO PasswordProcessing
END SELECT
'-------------------------------------------------------------------------
'File Format: 1 Master record with password and options
' Master record controls size of --
' Default 60 Event records (NumberofEvents)
' Default 60 Note records (NumberofNotes) <-- pointed to
' By StartingNote
' unlimited History records <-- pointed to by StartingHistory
OptionsProcessing:
DirectReturn = Yes
' Get Options
CALL GetOptions
' Be Extra Careful On File Deletion, Clobber Previous Password
IF Menu1 = MainMenuDelete THEN
EnteredPassword$ = Blank8$
GOTO PasswordProcessing
END IF
' No Password on Repeats
IF Menu1 > MainMenuDelete AND Menu1 < MainMenuHelp AND _
ApptFilename$ <> Blank8$ AND _
ApptPassword$ = EnteredPassword$ AND DirectReturn THEN
GOTO PasswordCheck
END IF
IF EnteredPassword$ <> ApptPassword$ THEN GOTO PasswordProcessing
IF Menu1 = MainMenuLastEntry OR ApptPassword$ = Blank8$ THEN
GOTO PasswordCheck
END IF
'=========================================================================
' Appointment File Password
PasswordProcessing:
FOR I = N1 TO N2
IF I = N2 AND NOT CreatingFile THEN GOTO ApptFirstWrite
IF I = N2 THEN
CALL PrepareforMessage
Tag$ = "Re-Enter Password To Confirm, Please"
CALL ShowIt(N0, N0, N0, Tag$)
END IF
InputResponse$ = Blank8$
EchoSuppression = Yes
IF NOT CreatingFile THEN
CALL ScreenBottoms
ELSE
CALL ReturnLine
CALL QuitLine
END IF
Tag$ = "Appointment File Password"
CALL ControlledInput(N24, N28, N24, N1, N8, Tag$, InputResponse$, _
N0, N1, N0, N1)
CALL ScreenBottomsDelete
EchoSuppression = No
IF Keystroke$ = CHR$(Esc) AND NOT CreatingFile THEN
CALL ClearScreenNormal(N1)
AutoStarted = No
GOTO MainMenuEntry
END IF
IF I = N1 THEN PasswordHold$ = InputResponse$
NEXT I
IF PasswordHold$ <> InputResponse$ THEN
CALL MajorBeeper
CALL Kolors(N14)
CALL BlankError
Tag$ = "Password Confirmation Doesn't Match -- Try Again"
CALL ShowIt(N0, N0, N0, Tag$)
GOTO PasswordProcessing
END IF
ApptFirstWrite:
CreatingFile = No
CALL Kolors(N6)
CALL BlankFatal
EnteredPassword$ = InputResponse$
IF ApptFileStatus$ <> "o" THEN
' If Not Old, Make New
'====================================================================
' New File, Clear Space For Master Record
ApptPassword$ = EnteredPassword$
' New Password
CALL SetOptions
' Set Options
ExitKeys = No
CALL MhLset (ApptBuffer$, Blank80$)
EventTableStable = No
FOR I = N1 TO NumberofEvents
CALL KeyStuff(KeyStatus)
Var = N1 + I
CALL PutApptRecord(Var)
NEXT I
FOR I = N1 TO NumberofNotes
CALL KeyStuff(KeyStatus)
Pointer = NumberofEvents + N1 + I
CALL PutApptRecord(Pointer)
NEXT I
ExitKeys = Yes
ApptFileStatus$ = "o"
ELSE
'===============================================================
' Password Check
PasswordCheck:
IF EnteredPassword$ <> ApptPassword$ THEN
' Check Password, Delete File Or Read Table
DirectReturn = No
CALL PrepareforError
Tag$ = "Password Invalid"
CALL ShowIt(N0, N0, N0, Tag$)
AutoStarted = No
GOTO MainMenuEntry
END IF
END IF
'=========================================================================
' Read Events
'=========================================================================
CALL ShowMult(N6, N23, N1, N40, N2) 'Clear File Name and Password Lines
' Delete File and Options Doesn't Need To Read Events (Wastes Time)
IF Menu1 <> MainMenuOptions THEN
IF Menu1 <> MainMenuDelete THEN
IF NOT EventTableStable THEN
' WhichEvent Current Event Number
' EventPageCounter Current Event Page (0 to n)
' ApptBuffer$ File Buffer
WhichEvent = N1
EventPageCounter = N0
CALL SetArrays ' Event/Note Array (re)set
CALL SequenceEventsTable
END IF
ELSE
'---------------------------------------------------------------
' Delete File
CALL CloseFiles
Tag$ = ApptFilename$ + ".cld"
CALL KillAFile(Tag$)
OnEditPage = No
CALL ClearScreenNormal(N1)
CALL PrepareforMessage
Tag$ = "File " + ApptFilename$ + " Successfully Deleted"
CALL ShowIt(N0, N0, N0, Tag$)
DirectReturn = No
EventTableStable = No
TimerSave! = TIMER
ApptFilename$ = Blank8$
GOTO MainMenuEntry
END IF
'====================================================================
' Print or Copy File
PrintorCopy$ = False$
IF Menu1 = MainMenuPrint OR Menu1 = MainMenuCopy THEN
' Print File or Copy to DOS File
IF Menu1 = MainMenuPrint THEN
PrintorCopy$ = "p"
ELSE
PrintorCopy$ = "w"
END IF
CALL PrintCopy
GOTO MainMenuEntry
END IF
ELSE
' Process Options
CALL Options
GOTO MainMenuEntry
END IF
' Options
IF Menu1 <> MainMenuLastEntry THEN
'====================================================================
' Opened File, Choice of Clock/Event/Note/History Displays
MenuLines(N1) = MenuLines(MainMenuLastEntry)
MenuLines(N2) = "Event Editing"
MenuLines(N3) = "Note Editing"
MenuLines(4) = "History Editing"
OnEditPage = No
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Appointment File Usage"
CALL Titles(N1)
CALL MenuDriver(N4, MenuEditing, N6, Nm1, No, N0, N1, N1)
IF MenuExit = MenuCancelled THEN
CALL ClearScreenNormal(N1)
Menu1 = MainMenuUse
GOTO MainMenuEntry
END IF
SELECT CASE MenuEditing
CASE 1
Menu1 = MainMenuLastEntry
CASE 2
CASE 3, 4
IF MenuEditing = 3 THEN
Tag$ = "N"
ELSE
Tag$ = "H"
END IF
CALL NotesHistory(Tag$)
END SELECT
END IF
'=========================================================================
' Start Event Editing, Fill One-Screen Menu Array
'=========================================================================
EventEditStart:
OnEditPage = No
MenuSingleLine = No
ResequenceEvents = No
RedisplayNotesEvents = Yes
IF Menu1 = MainMenuLastEntry THEN
GOTO EventOverdueCleared
END IF
EventMenuFill:
WhichEventSave = WhichEvent
FOR JJ = N1 TO EditPagesize
WhichEvent = JJ + EventPageCounter * EditPagesize
CALL ApptToMenu(N1)
MenuLines(JJ) = CurrentEventLine$
NEXT JJ
WhichEvent = WhichEventSave
' Event Editing, Sort If Changed
IF OnScreen THEN
Label1$ = STR$(N1 + EventPageCounter * EditPagesize)
Label2$ = STR$((EventPageCounter + N1) * EditPagesize)
Label$ = "(" + RIGHT$(Label1$, LEN(Label1$) - N1) + Hyphen$ + _
RIGHT$(Label2$, LEN(Label2$) - N1) + ")"
IF FooterSize >= N6 THEN CALL ShowIt(N3, F5HelpRow, N1, Blank8$)
CALL ShowIt(N3, N17, N1, Blank80$) ' Clear Row Above Edit
CALL ShowIt(N13, N0, N0, Label$) ' Print Event Label
END IF
EventScreen:
IF NOT OnScreen OR OnScreenFirst THEN
IF NOT MenuSingleLine AND NOT OnScreen THEN
'---------------------------------------------------------------
' Display Event Editing Full Screen
CALL Kolors(N5)
TimerDisplaySuppress = Yes
CLS
OnEditPage = Yes
CALL Kolors(N19)
Tag$ = "Repeat Date Day Time " + _
"Event (Page " + RIGHT$(STR$(EventPageCounter + _
N1), N2) + " Of " + RIGHT$(STR$(NumberofEvents \ N20), _
N2) + ")" + SPACE$(N25)
CALL ShowIt(N0, N1, N1, Tag$)
END IF
FOR I = N1 TO N3
CALL ShowIt(N14, N21 + I, N1, EventInstructions1(I))
NEXT
FOR I = N1 TO N3
CALL ShowIt(N9, N21 + I, N28, EventInstructions2(I))
NEXT
CALL ShowIt(N0, N25, N1, EventInstructions3)
FOR I = N1 TO N3
CALL ShowIt(N19, N21 + I, N50, EventNoteSharedIns(I))
NEXT
OnScreenFirst = No
END IF
'-------------------------------------------------------------------------
' Accept Event Editing Choice
'-------------------------------------------------------------------------
EventMenuExit:
MenuSpecialExit = SpecialExitAllowed'Allow Special Functions
MenuEventEditing = WhichEvent - (EditPagesize * EventPageCounter)
IF NOT OnScreen THEN MenuRow = N1 ELSE MenuRow = 17
EditingEvents = Yes
CALL MenuDriver(EditPagesize, MenuEventEditing, MenuRow, N0, _
MenuSingleLine, MenuSpecialExit, N0, N0)
EditingEvents = No
WhichEvent = (EditPagesize * EventPageCounter) + MenuEventEditing
MenuSingleLine = Yes
' Accept Choice
SELECT CASE MenuSpecialExit
CASE MenuNormalExit
GOTO EventMenuCancel
CASE SpecialExitF2
IF ResequenceEvents THEN
GOTO EventMenuOut
ELSE
GOTO EventMenuError
END IF
CASE SpecialExitDelete
' Delete Event
EventRepeat$ = "X "
ResequenceEvents = Yes
GOTO InDone
CASE SpecialExitPgUp
IF EventPageCounter = N0 THEN
GOTO EventMenuError
ELSE
EventPageCounter = EventPageCounter - N1
END IF
CASE SpecialExitPgDn
IF EventPageCounter = (NumberofEvents \ EditPagesize - N1) THEN
GOTO EventMenuError
ELSE
EventPageCounter = EventPageCounter + N1
END IF
CASE SpecialExitHomeKey
IF EventPageCounter = N0 THEN
GOTO EventMenuError
ELSE
EventPageCounter = N0
END IF
CASE SpecialExitEndKey
IF EventPageCounter = (NumberofEvents \ EditPagesize - N1) THEN
GOTO EventMenuError
ELSE
EventPageCounter = NumberofEvents \ EditPagesize - N1
END IF
CASE ELSE
' Error, Try Again
EventMenuError:
CALL MinorBeeper
GOTO EventMenuExit
END SELECT
'=========================================================================
' Reset Page Size and Event Number and Continue
WhichEvent = (EditPagesize * EventPageCounter) + N1
MenuSingleLine = No
GOTO EventMenuFill
'-------------------------------------------------------------------------
' Cancel From Event Editing Resequences By Date/Time If Changed
'-------------------------------------------------------------------------
EventMenuCancel:
IF MenuExit = MenuCancelled THEN
EventMenuOut:
MenuSingleLine = No
CALL ClearOverdueTable
' Esc Sort Events
EventOverdueCleared:
IF ResequenceEvents OR OnScreen THEN
IF NOT OnScreen THEN
CALL Kolors(N5)
ClearLimit = 4
ELSE
ClearLimit = 8
Tag$ = SPACE$(N9)
CALL ShowIt(N3, N17, N1, Tag$)
END IF
ScreenMultRow = 26 - ClearLimit
CALL ShowMult(N0, ScreenMultRow, N1, N80, ClearLimit)
END IF
' (Re)Sequence Events
CALL SequenceEventsTable
' Display Calendar Flag
IF ResequenceEvents THEN RedisplayCalendars = Yes
' Resequence In Place From F2
IF MenuSpecialExit = SpecialExitF2 THEN
WhichEvent = N1
EventPageCounter = N0
OnScreenFirst = Yes
GOTO EventEditStart
END IF
' Reprint Bottom of Screen Instructions
' On Screen Returns Right To Clock Loop
IF OnScreen THEN
RefreshInstructions = Yes
GOTO TimingLoopStart
END IF
CurrentEvent = N1
' Off Screen Displays Whole Clock Page
GOTO ClockInitialize
END IF
'=========================================================================
' Event An Event Line--Provide Instructions
'=========================================================================
CALL ApptToMenu(N1) ' Split Variables
' Bottom of Page Editing Instructions for ControlledInput
FOR I = N1 TO 4
CALL ShowIt(N14, N21 + I, N34, EventInput(I))
NEXT
'=========================================================================
' Edit An Event Line--Process Each Field
EventFields:
ResequenceEvents = Yes
OnScreenFirst = Yes
IF NOT OnScreen THEN
BoxRow = MenuEventEditing + N1
ELSE
BoxRow = MenuEventEditing + 17
END IF
'-------------------------------------------------------------------------
' Before Editing, Write Previous (Non-Null) Record To History
IF CurrentEventLine$ <> Blank80$ AND _
CurrentEventLine$ <> NullEvent$ THEN
EventtoHistory = Yes
HistoryBuffer$ = CurrentEventLine$
CALL WritetoHistory
END IF
' To History
'-------------------------------------------------------------------------
'(Bi/Multi)Weekly/Daily/Monthly/Quarterly/Yearly Indicators (EventRepeat$)
FieldRepeat:
WhichEventField = N1
GOSUB InstructionFill
GOTO RepeatIn
' Display Whatever Edit Instructions are Appropriate
' Along With Any Returned Error Message
InstructionFill:
FOR I = N1 TO 4
CALL ShowIt(N13, (N21 + I), N1, (EditInstructions(WhichEventField, I)))
NEXT I
CALL EventErrorMessage
RETURN
'
RepeatIn:
CALL ControlledInput(BoxRow, N4, N1, N1, N3, Blank0$, EventRepeat$, _
N0, N0, N0, N0)
ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _
RIGHT$(Keystroke$, N1)) GOTO FieldText, InDone, InDone, FieldLimRep
'-------------------------------------------------------------------------
' Limited-Repeat Indicator (EventLimRepeat$) Only Shows
' If EventRepeat$ Has Something
FieldLimRep:
IF EventRepeat$ = SPACE$(N3) THEN
EventLimRepeat$ = SPACE$(N2)
ELSE
' Skip if Null
WhichEventField = 8
GOSUB InstructionFill 'Instructions
CALL ControlledInput(BoxRow, N1, N1, N1, N2, Blank0$, _
EventLimRepeat$, N1, N0, N0, N0)
END IF
ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _
RIGHT$(Keystroke$, N1)) GOTO FieldRepeat, InDone, InDone, FieldMonth
'-------------------------------------------------------------------------
' Month (EventMonth$)
FieldMonth:
WhichEventField = N2
GOSUB InstructionFill 'Instructions
CALL ControlledInput(BoxRow, N8, N1, N1, N2, Blank0$, EventMonth$, _
N1, N0, N0, N0)
ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _
RIGHT$(Keystroke$, N1)) GOTO FieldLimRep, InDone, InDone, FieldDay
'-------------------------------------------------------------------------
' Day (EventDay$)
FieldDay:
WhichEventField = 4
GOSUB InstructionFill 'Instructions
CALL ControlledInput(BoxRow, N11, N1, N1, N2, Blank0$, EventDay$, _
N1, N0, N0, N0)
ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _
RIGHT$(Keystroke$, N1)) GOTO FieldMonth, InDone, InDone, FieldYear
'-------------------------------------------------------------------------
' Year (EventYear$)
FieldYear:
WhichEventField = 5
GOSUB InstructionFill 'Instructions
CALL ControlledInput(BoxRow, N14, N1, N1, N2, Blank0$, EventYear$, _
N1, N0, N0, N0)
IF EventYear$ = SPACE$(N2) THEN
EventYear1st2$ = SPACE$(N2)
ELSE
' First Two Digits of Year is Dependent on DOS Date
' Next Century if Last Two Is Before Last Two In DOS Date
' This Century if Last Two Is Equal/More Than Last Two In DOS Date
' (So the program doesn't have to be changed if it lives that long!)
IF VAL(EventYear$) < VAL(MID$(TodaysDate$, N3, N2)) THEN
EventYear1st2$ = RIGHT$(STR$(VAL(MID$(TodaysDate$, N1, N2)) _
+ N1), N2)
ELSE
EventYear1st2$ = MID$(TodaysDate$, N1, N2)
END IF
END IF
ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _
RIGHT$(Keystroke$, N1)) GOTO FieldDay, InDone, InDone, FieldHour
'-------------------------------------------------------------------------
' Hour (EventHour$)
FieldHour:
WhichEventField = N6
GOSUB InstructionFill 'Instructions
CALL ControlledInput(BoxRow, N21, N1, N1, N2, Blank0$, EventHour$, _
N1, N0, N0, N0)
ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _
RIGHT$(Keystroke$, N1)) GOTO FieldYear, InDone, InDone, FieldMinute
'-------------------------------------------------------------------------
' Minute (EventMinute$)
FieldMinute:
WhichEventField = N7
GOSUB InstructionFill 'Instructions
CALL ControlledInput(BoxRow, N24, N1, N1, N2, Blank0$, EventMinute$, _
N1, N0, N0, N0)
ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _
RIGHT$(Keystroke$, N1)) GOTO FieldHour, InDone, InDone, FieldText
'-------------------------------------------------------------------------
' Text (EventText$)
FieldText:
WhichEventField = N3
GOSUB InstructionFill 'Instructions
CALL ControlledInput(BoxRow, N28, N1, N1, TextSize, Blank0$, _
EventText$, N0, N0, N0, N1)
ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _
RIGHT$(Keystroke$, N1)) GOTO FieldMinute, InDone, InDone, FieldRepeat
GOTO FieldRepeat
'=========================================================================
' Accept Change, Check The Date/Time And Redisplay The Results
'=========================================================================
' Combine Date/Time, Check For Validity
InDone:
CALL CombineDateTime
DateToValidate$ = EventDate$ + EventTime$
CALL CheckDate(DateToValidate$)
IF DateValidation THEN
CALL MajorBeeper
GOTO FieldRepeat
END IF
DeleteEvent:
CALL ValidateEventDate
IF EventValidationError = N1 THEN
CALL MajorBeeper
GOTO EventFields
END IF
'-------------------------------------------------------------------------
' Repack Event Array For Menu And Rewrite Record In File
CALL RepackApptRecord
CALL BuildMenuLine
MenuLines(MenuEventEditing) = CurrentEventLine$
CALL MhLset (ApptBuffer$, CurrentEventRecord$)
Pointer = N1 + WhichEvent
CALL PutApptRecord(Pointer)
EventTableStable = No
GOTO EventScreen
'=========================================================================
' Display Clock Display--Displacement Different If File Open
ClockInitialize:
IF Menu1 = MainMenuClock THEN
ApptFile = No
ELSEIF EventTableStable THEN
ApptFile = Yes
END IF
WholeClock = Yes
OnEditPage = No
RedisplayCalendars = Yes
RefreshInstructions = Yes
FromOverduePage = No
ClockScreen = Yes
ClockRow = N0
IF ApptFile THEN
ClockColumn = 13
ELSE
ClockColumn = N7
END IF
CALL Kolors(N3)
TimerDisplaySuppress = Yes
CLS
CALL KeyStuff(KeyStatusAbs)
' Calendar Offset
IF ApptFile THEN
CalendarStartColumn = 10
ELSE
CalendarStartColumn = 5
END IF
' Event Display When Reprinting Time
IF ApptFile THEN RedisplayNotesEvents = Yes
Var1 = CalendarStartRow + N5
Var2 = N1 + CalendarStartColumn + CalendarColumns(N2)
Tag$ = " (Computing Calendars) "
CALL ShowIt(N14, Var1, Var2, Tag$)
'-------------------------------------------------------------------------
' Change Condition Of Sound On Display
IF ApptFile THEN
X5 = N7
X6 = N0
ELSE
X5 = 18
X6 = N3
END IF
ScreenMultRow = X5 + N1
ScreenColumn = X6 + N1
CALL ShowMult(N6, ScreenMultRow, ScreenColumn, N6, N2)
CALL ShowIt(N0, ScreenMultRow, N0, "Sound")
GOSUB SoundDisplay
GOTO FilenameDisplay
SoundDisplay:
CALL ShowIt(N6, (X5 + N2), (X6 + N1), (SoundLevels$(SoundLevel)))
RETURN
'-------------------------------------------------------------------------
FilenameDisplay:
IF ApptFile THEN
'--------------------------------------------------------------------
' Display File Name
CALL GetFilenameLength
Tag$ = MID$(ApptFilename$, N1, FilenameLength) + "'s"
CALL ShowErase(N0, N1, N1, N10, Tag$)
Tag$ = "Calendar"
CALL ShowErase(N0, N2, N1, N10, Tag$)
END IF
'--------------------------------------------------------------------
' Display Lines Of Clock
FOR ClockLine = N1 TO N7
CALL KeyStuff(KeyStatus)
ScreenRow = ClockRow + ClockLine
ScreenColumn = ClockColumn + N2
SELECT CASE ClockLine
CASE 1
CALL ShowIt(N10, N0, N0, (ClockGraphics(N1)))
CASE 2, 6
CALL ShowIt(N3, N0, N0, (ClockGraphics(N2)))
CASE 3 TO 5
CALL ShowIt(N3, N0, N0, (MID$(ClockGraphics(N2), _
N1, N1)))
ScreenColumn = ClockColumn + 64
CALL ShowIt(N0, N0, N0, (MID$(ClockGraphics(N2), _
N1, N1)))
CASE 7
CALL ShowIt(N10, N0, N0, (ClockGraphics(N3)))
END SELECT
NEXT ClockLine
' Display Box around Time, Same Color as Clock Foreground
CALL Kolors(N3)
CALL BoxDraw(N1, ClockRow% + N3, ClockRow% + N5, ClockColumn% + N4, _
ClockColumn% + N62)
TimeBlock = Yes
'=========================================================================
' BEGINNING OF ONE SECOND TIMING LOOP
'=========================================================================
' Update The Time--Hold A Tight Loop Until Time Changes Seconds
' or until a keystroke is made
' Pop up date and time enabled if using appointment file -- only here!!
TimingLoopStart:
IF ApptFile THEN SrPopDateTime = Yes
InterruptedLoop = No
LoopCounter = N0
LoopCounterShow = No
DO
CurrentTimer$ = TIME$
IF DebugRequested THEN
LoopCounter = LoopCounter + N1
END IF
'---------------------------------------------------------------
CALL KeyStuff(KeySingle)
IF LEN(Keystroke$) > N0 THEN
InterruptedLoop = Yes
LoopCounterShow = Yes
GOTO TimingLoopEnd
END IF
LOOP WHILE CurrentTimer$ = PreviousTime$
LoopCounterShow = Yes
PreviousTime$ = CurrentTimer$
'-------------------------------------------------------------------------
IF ApptFile AND (EventsScheduled <> PrintedEventsScheduled OR _
WholeClock = Yes) THEN
CALL ShowMult(N6, N4, N1, N9, N3)
EventsScheduled$ = LTRIM$(RIGHT$(STR$(EventsScheduled), N3))
IF EventsScheduled = N0 THEN EventsScheduled$ = Noo$
CALL ShowIt(N6, N4, N2, EventsScheduled$)
CALL ShowIt(N0, Nm1, N1, "Event")
IF EventsScheduled <> N1 THEN
CALL ShowIt(N0, N0, Nm1, "s")
ELSE
CALL ShowIt(N0, N0, Nm1, Blank1$)
END IF
CALL ShowIt(N0, Nm1, N1, "Scheduled")
PrintedEventsScheduled = EventsScheduled
End If
'-------------------------------------------------------------------------
CALL UpdateClockScreen
'=========================================================================
' Sound The Alarm On An Overdue Event--Skip if Neither--Alarm Overrides
'=========================================================================
' If Appointment File In Use, Then Check Alarm Table For Overdue Event
IF ApptFile AND NOT AlarmSet THEN
'--------------------------------------------------------------------
' AlarmSet Is Set If Alarm Is To Ring
WarningSet = No
' Reset
SrPopTime# = HighestValue#
FOR I = N1 TO NumberofEvents
IF Alarms(I).Alarm <> 0# AND Alarms(I).Alarm < SrPopTime# THEN
SrPopTime# = Alarms(I).Alarm
END IF
IF Alarms(I).Warning <> 0# AND _
Alarms(I).Warning < SrPopTime# THEN
SrPopTime# = Alarms(I).Warning
END IF
IF Pending AND Alarms(I).Warning <> 0# AND _
Alarms(I).Warning <= CurrentDateTime# THEN
WarningSet = Yes
END IF
' Set Warning To Blink
IF Alarms(I).Alarm <> 0# AND _
Alarms(I).Alarm <= CurrentDateTime# THEN
AlarmSet = Yes
END IF
NEXT I
IF SrPopTime# <> HighestValue# THEN
SrPopDateTime = Yes ' Enable pop
ELSE
SrPopDateTime = No ' Else disable
END IF
END IF
IF (AlarmSet OR WarningSet) AND ApptFile THEN
' If Alarm or Warning Was Found On First One, Check All Others Before
' Processing the Alarm
IF SrAutoPopDown AND NOT SrAutoPopDownHappened THEN
SrAutoPopDownHappened = Yes ' Kill AutoPop If Alarm or Warning
END IF
FOR JJ = N1 TO NumberofEvents
CALL KeyStuff(KeyStatus)
IF Pending AND Alarms(JJ).Warning <> 0# AND _
Alarms(JJ).Warning <= CurrentDateTime# THEN ' Skip Later
WarningSet = Yes
Alarms(JJ).Warning = 0#
PendingEvents(JJ) = JJ
END IF
' Set Warning To Blink
IF Alarms(JJ).Alarm <> 0# AND _
Alarms(JJ).Alarm <= CurrentDateTime# THEN ' Later Entry Skip
AlarmMusicPlayed = No
AlarmSet = Yes
ResequenceEvents = Yes
RedisplayNotesEvents = Yes
END IF
' Load Alarm
NEXT JJ
IF AlarmSet THEN WarningSet = No' Alarm Always Takes Precedence
' Play Music
IF SoundLevel > N2 THEN CALL PlayAlarmWarning(WarningSet)
' Test for Alarm First
IF AlarmSet THEN
RedisplayCalendars = Yes ' Alarm May Change Calendars
' Reset Alarm Flag and Resort The Event Table After Alarm Rings
AlarmSet = No
SrPopDateTime = No ' Pop up date and time disabled
CALL ProcessAlarm
IF FromOverduePage THEN
GOTO ClockInitialize
END IF
ELSE
' Force Footer Regeneration
RedisplayNotesEvents = Yes
FooterAction$ = "e"
END IF
END IF
'=========================================================================
' On The Mark, Sound The Chimes
IF NOT FirstTimeClock AND ChimeCount <> N0 AND _
CurrentMinute MOD 15 = N0 AND SoundLevel = 4 THEN
' Ring Chime
IF CurrentMinute THEN
PlayString$ = PrecursorChime$ + Strng$(ChimeCount, 67) ' "C"
ELSE
PlayString$ = Chime$ + PrecursorChime$ + Strng$(ChimeCount, 71)
END IF ' "G"
CALL PlayStuff(PlayString$)
ErrorSwitch = No
ChimeCount = N0 ' reset count
END IF
'=========================================================================
' All Over, Save Date, Timer, Hours, Minutes, Seconds
ChimeCount = N0
PreviousDate$ = TodaysDate$
PreviousHour = CurrentHour
PreviousMinute = CurrentMinute
PreviousSecond = CurrentSecond
PreviousQuarter = CurrentQuarter
PrevQuarterPosition = CurrentHourPosition
FirstTimeClock = No
FooterAction$ = Blank1$
IF FooterRecall THEN 'Check Instruction Pop-Back Timer
PopTimerNow! = FIX(TIMER)
IF PopTimerNow! - PopTimerStart! = 10! THEN
RedisplayNotesEvents = Yes
RefreshInstructions = Yes
FooterRecall = No
END IF
END IF
'=========================================================================
' END OF ONE SECOND TIMING LOOP--ACCEPT A KEYSTROKE
'=========================================================================
' Note: Pop-down is done in Sub KeyStuff, NOT Here!
CALL KeyStuff(KeySingle)
' Place Caplock and Numlock on screen if needed
TimingLoopEnd:
AutoStarted = No
SELECT CASE (LEN(Keystroke$) + N1)
CASE 1 ' No Keystroke
GOTO EndOfKeys
CASE 2 ' Length One Keys
GOTO ClockScreenKey
CASE 3 ' Length Two Keys
GOTO TwoByteKey
END SELECT
'=========================================================================
' Length One Keys--Print, Letters, Escape, and Del (Numlocked is .)
' and End (Numlocked is 1)
' and West (Numlocked is 4)
' and East (Numlocked is 6)
' and North (Numlocked is 8)
' and South (Numlocked is 2)
' and PgUp (Numlocked is 9)
' and PgDn (Numlocked is 3)
ClockScreenKey:
SELECT CASE InString(CHR$(Prnt) + "AaSsDdEeHhNn.1Tt468293" + CHR$(Esc), _
Keystroke$)
'--------------------------------------------------------------------
CASE 1 ' Print Appointment File
IF NOT ApptFile THEN
GOTO BadKey
ELSE
ClockScreenPrint = Yes
PrintorCopy$ = "p"
CALL PrintCopy
END IF
'--------------------------------------------------------------------
CASE 2 TO 5 ' Set Sound (A or S, Does Not Matter)
' Level 1=Utterly Silent 2=Errors Only
' 3=Alarms 4=Chimes (Everything)
IF ApptFile THEN
SoundLevel = SoundLevel - N1
IF SoundLevel = N0 THEN SoundLevel = 4
ELSE
IF SoundLevel <> 4 THEN SoundLevel = 4 ELSE SoundLevel = N1
END IF
GOSUB SoundDisplay
'--------------------------------------------------------------------
CASE 6, 7, 16, 17 ' Calendars
' Display Calendars For Different Date Or Return
' To Today's Calendars
' OtherCalendars$ Tells Which Calendar Footing
'---------------------------------------------------------------
DateSpecific:
IF InString("Dd", Keystroke$) = N0 AND _
NOT ScrollingCalendars THEN
' Return to Today ("T") Requested
IF NormalCalendars THEN GOTO BadKey ' No Return If There
OtherCalendars = No ' "D"ate Other
NormalCalendars = Yes ' Normal Calendars
CalendarDate$ = TodaysDate$
ELSE
'---------------------------------------------------------------
' Specific Date ("D") or Calendar Scrolling Requested
OtherCalendars = Yes
NormalCalendars = No ' Other Calendars
'---------------------------------------------------------------
END IF
'---------------------------------------------------------------
RedisplayNotesEvents = Yes ' All Calendars
RefreshInstructions = Yes
GOSUB HelpPromptKill
TimeBlock = Yes
IF NOT NormalCalendars AND NOT ScrollingCalendars THEN
GOSUB BottomErase
'----------------------------------------------------------
GetDate:
RequestedCalendars$ = MID$(CalendarDate$, 5, 4) + _
MID$(CalendarDate$, 1, 4)
CALL ControlledInput(N25, N50, N25, _
N17, N8, "Enter Desired Date (MMDDYYYY)", _
RequestedCalendars$, N1, N0, N0, N1)
DesiredCalendars$ = MID$(RequestedCalendars$, 5, 4) + _
MID$(RequestedCalendars$, N1, 4)
IF RequestedCalendars$ = Blank8$ THEN
CALL MajorBeeper
GOTO GetDate
END IF
DateToValidate$ = DesiredCalendars$ + SPACE$(4)
CALL CheckDate(DateToValidate$)
IF DateValidation THEN
CALL MajorBeeper
GOTO GetDate
END IF
'---------------------------------------------------------------
CalendarDate$ = DesiredCalendars$'Other Calendars
END IF
'---------------------------------------------------------------
' Normal/Scroll Calendars Comes Here
GOSUB BottomErase
CALL ShowIt(N14, N25, Nm2, " (Computing) ")
CALL PrintCalendar
GOTO EndOfKeys
'
BottomErase:
CALL Kolors(N3)
CALL ClearLast4
RETURN
'===================================================================
CASE 8, 9
' Edit Events (E) (File Open) or Use File (File Closed)
ClockScreen = No
Menu1 = MainMenuUse
RedisplayCalendars = Yes
IF ApptFile THEN ' Appt File Already Open--Edit
EditPagesize = 20
OnScreen = No
OnEditPage = No
WhichEvent = N1
EventPageCounter = N0
GOTO EventEditStart
END IF
CALL DirectReturnCheck
CALL ClearScreenNormal(N1) 'Return to Main Menu
GOTO MainMenuEntry
'--------------------------------------------------------------------
CASE 10, 11 ' H or h
' Change or View History (H)
NotesorHistory$ = "H"
GOTO GoNotes
'--------------------------------------------------------------------
CASE 12, 13
' Change or View Notes (N)
NotesorHistory$ = "N"
GoNotes:
IF NOT ApptFile THEN GOTO BadKey
EditPagesize = 20
OnScreen = No
IF NotesorHistory$ = "H" AND _
LOF(FilenumAppt) \ N80 < StartingHistory THEN
GOTO BadKey
ELSE
ClockScreen = No
CALL NotesHistory(NotesorHistory$)
GOTO ClockInitialize
END IF
'--------------------------------------------------------------------
CASE 14 ' . for Delete
GOTO DelOverdue
'--------------------------------------------------------------------
CASE 15 ' 1 for End
GOTO PrinterPage
'====================================================================
CASE 18, 19 ' Scrolling Calendars With Arrows
' Scrolling Calendars One Month at a Time With West or East
ScrollCalendars:
OtherCalendars = Yes
ScrollingCalendars = Yes
'---------------------------------------------------------------
' Get Current Calendar Value and Set Day to First of the Month
CalendarYear = VAL(MID$(CalendarDate$, N1, 4))
CalendarMonth = VAL(MID$(CalendarDate$, 5, N2))
'---------------------------------------------------------------
' Test if Later (Right arrow or 6) or earlier (Left arrow or 4)
IF InString(CHR$(West) + "4", RIGHT$(Keystroke$, N1)) THEN
'----------------------------------------------------------
' Left arrow means one month earlier
CalendarMonth = CalendarMonth - N1
IF CalendarMonth = N0 THEN
CalendarMonth = 12
CalendarYear = CalendarYear - N1
IF CalendarYear < N0 THEN CalendarYear = 9999
END IF
ELSE
'----------------------------------------------------------
' Right arrow means one month later
CalendarMonth = CalendarMonth + N1
IF CalendarMonth = 13 THEN
CalendarMonth = N1
CalendarYear = CalendarYear + N1
IF CalendarYear > 9999 THEN CalendarYear = N0
END IF
END IF
'---------------------------------------------------------------
' Now Put the CalendarDate Back Together and Generate Calendars
CALL YearAdjust(CalendarYear, AdjustedYear$)
CalendarDate$ = ZeroFill$(AdjustedYear$ + _
RIGHT$(STR$(CalendarMonth), N2) + "01")
GOTO DateSpecific
'--------------------------------------------------------------------
CASE 20 ' 8 for North
GOTO ScrollNotesBack
'--------------------------------------------------------------------
CASE 21 ' 2 for South
GOTO ScrollNotesFore
'--------------------------------------------------------------------
CASE 22 ' 9 for PgUp
GOTO ScrollEventsFore
'--------------------------------------------------------------------
CASE 23 ' 3 for PgDn
GOTO ScrollEventsBack
'--------------------------------------------------------------------
CASE 24 ' Escape Goes Back To Main Menu (Esc)
Menu1 = MainMenuLastEntry
ClockScreen = No
CALL ClearScreenNormal(N1)
EditPagesize = 20
MenuSingleLine = No
OnScreen = No
CALL ClearOverdueTable
GOTO MainMenuEntry
'--------------------------------------------------------------------
CASE ELSE ' Other Length One Keys
GOTO BadKey
'--------------------------------------------------------------------
END SELECT
GOTO EndOfKeys ' Normal One-Length Key Exit
'=========================================================================
' Length Two Keys--Scroll Events/Notes/Calendars, Delete Overdue,DOS,DOS
' PgUp,PgDn,North,South,Del,F3,F4,F5,End,East,West,F6,F7
'=========================================================================
TwoByteKey:
SELECT CASE InString(CHR$(PgUp) + CHR$(PgDn) + CHR$(North) + _
CHR$(South) + CHR$(Del) + CHR$(F3) + CHR$(F4) + CHR$(F5) + _
CHR$(EndKey) + CHR$(East) + CHR$(West) + CHR$(F6) + _
CHR$(F7), RIGHT$(Keystroke$, N1))
'--------------------------------------------------------------------
CASE 1 ' PgUp Previous Event Window
' Scroll Events Backwards Footer Minus Notes Minus Overdue
ScrollEventsFore:
IF CurrentEvent = N1 OR NOT ApptFile THEN GOTO BadKey
FooterAction$ = "e"
RedisplayNotesEvents = Yes
IF CurrentEvent <= (FooterSize - NoteSize - OverdueCount) THEN
CurrentEvent = N1
ELSE
CurrentEvent = CurrentEvent - _
(FooterSize - NoteSize - OverdueCount)
END IF
'--------------------------------------------------------------------
CASE 2 ' PgUp Previous Event Window
' Scroll Events Forwards Footer Size Minus Notes Minus Overdue
ScrollEventsBack:
IF NOT ApptFile THEN GOTO BadKey
FooterAction$ = "e"
RedisplayNotesEvents = Yes
IF (CurrentEvent + N2 * _
(FooterSize - NoteSize - OverdueCount)) <= _
NumberofEvents + N1 THEN
CurrentEvent = CurrentEvent + _
(FooterSize - NoteSize - OverdueCount)
ELSE
CurrentEvent = NumberofEvents + N1 - _
(FooterSize - NoteSize - OverdueCount)
CALL MinorBeeper
END IF
'--------------------------------------------------------------------
CASE 3 ' North Previous Note Window
' Scroll Notes Backwards Note Size
ScrollNotesBack:
IF NoteSize = N0 OR CurrentNote = N1 OR _
NOT ApptFile THEN GOTO BadKey
FooterAction$ = False$
RedisplayNotesEvents = Yes
IF CurrentNote <= NoteSize THEN
CurrentNote = N1
ELSE
CurrentNote = CurrentNote - NoteSize
END IF
'--------------------------------------------------------------------
CASE 4 ' South for Next Note Window
' Scroll Notes Forwards Note Size (south)
ScrollNotesFore:
IF NoteSize = N0 OR NOT ApptFile THEN GOTO BadKey
FooterAction$ = False$
RedisplayNotesEvents = Yes
IF (CurrentNote + N2 * (NoteSize)) <= _
NumberofNotes + N1 THEN
CurrentNote = CurrentNote + NoteSize
ELSE
CurrentNote = NumberofNotes + N1 - NoteSize
CALL MinorBeeper
END IF
'--------------------------------------------------------------------
CASE 5 ' Del for Clear Overdue Events
' Clear Overdue Event From Display If There
DelOverdue:
IF NOT ApptFile OR OverdueCount = N0 THEN GOTO BadKey
RedisplayNotesEvents = Yes
RefreshInstructions = Yes
CALL ClearOverdueTable
TimerSave! = TIMER
CALL PrintCalendar
'--------------------------------------------------------------------
CASE 6 ' F3 for On-Screen Events
' On-Screen Events (F3) -- Blocks of 4
IF NOT ApptFile THEN GOTO BadKey
ClockScreen = Yes
OnEditPage = No
OnScreenFirst = Yes
OnScreen = Yes
Menu1 = MainMenuUse
EditPagesize = 4
WhichEvent = N1 + _
EditPagesize * (CurrentEvent - N1) \ EditPagesize
EventPageCounter = (WhichEvent - N1) \ EditPagesize
GOSUB HelpPromptKill
GOTO EventEditStart
'--------------------------------------------------------------------
CASE 7 ' F4 for On-Screen Notes
' On-Screen Notes (F4) -- Blocks of 4
IF NOT ApptFile THEN GOTO BadKey
CurrentNote = N1 + _
EditPagesize * (CurrentNote - N1) \ EditPagesize
ClockScreen = Yes
OnEditPage = No
OnScreenFirst = Yes
OnScreen = Yes
Menu1 = MainMenuUse
EditPagesize = 4
GOSUB HelpPromptKill
CALL NotesHistory("N")
'--------------------------------------------------------------------
CASE 8 ' F5 for Pop-Back
' Instruction Pop-Back for 10 Seconds or Key Pressed (F5)
IF NOT ApptFile OR FooterSize < N6 THEN GOTO BadKey
FooterRecall = Yes
CALL Instructions 'Give Instructions
PopTimerStart! = FIX(TIMER) 'Set 10-Second Timer
PopTimerNow! = PopTimerStart!
'--------------------------------------------------------------------
CASE 9 ' End for Page Eject
' Page Eject Printing Event File (End)
PrinterPage:
IF NOT ApptFile THEN GOTO BadKey
CALL InitPrinter
CALL PageEject
IF LprintTerminate THEN
LprintTerminate = No
END IF
'--------------------------------------------------------------------
CASE 10, 11 ' East/West Arrows for Scrolling
GOTO ScrollCalendars
'--------------------------------------------------------------------
CASE 12 ' F6 For DOS Shell
CALL DOSShell(N1)
GOTO ClockInitialize
'--------------------------------------------------------------------
CASE 13 ' F7 For DOS Prestored Command
CALL DOSShell(N2)
GOTO ClockInitialize
'--------------------------------------------------------------------
CASE ELSE ' Other Length Two Keystrokes
GOTO BadKey
'--------------------------------------------------------------------
END SELECT
GOTO EndOfKeys ' Normal Two-Length Key Exit
'=========================================================================
' Blank F5 Help if needed
HelpPromptKill:
IF FooterSize >= N6 THEN CALL ShowIt(N3, F5HelpRow, N1, Blank8$)
RETURN
'-------------------------------------------------------------------------
' Invalid Keystroke or Nothing To Do On Valid One
'-------------------------------------------------------------------------
BadKey:
CALL MinorBeeper
'=========================================================================
' Keystroke Processing Finished, Refresh Events And Start Loop Again
'=========================================================================
' Refresh Events/Notes and Instructions If Required
EndOfKeys:
IF ApptFile AND RedisplayNotesEvents THEN
CALL RefreshEventsNotes
IF FromOverduePage THEN
GOTO ClockInitialize
END IF
END IF
IF RefreshInstructions THEN CALL Instructions
'-------------------------------------------------------------------------
' Do the Sound Indicator If Necessary
IF RedisplayNotesEvents OR TimeBlock THEN GOSUB SoundDisplay
'-------------------------------------------------------------------------
OnEditPage = No
ClockScreen = Yes
RedisplayNotesEvents = No
TimeBlock = No
ScrollingCalendars = No
IF NOT InterruptedLoop THEN WholeClock = No
IF SrAutoPopDown AND (AutoMode$ = True$) AND NOT SrAutoPopDownHappened _
AND NOT SrAutoPopDownReady THEN
SrAutoPopDownReady = Yes
END IF
'=========================================================================
' Start The Timing Loop Over Again
GOTO TimingLoopStart
END SUB
'=========================================================================
' This Procedure Exits ONLY Through a Trapped Error and Always Returns
' (except in primitive mode, which ends in the main program)
'=========================================================================
'======================== END OF CAL2.BAS =============================
'========================================================================